(SETQ IBASE (ADD1 7)) 


(DEFPROP FORFNS 
 (NIL FORFNS %FOR %WHILE DONEP) 
VALUE)

(DEFPROP FORFNS 
 (NIL FORFNS %FOR %WHILE DONEP) 
VALUE)

(DEFPROP %FOR 
 (LAMBDA(VAR CONTROL WHILE ACTION UNLESS)
  (SUBST VAR
	 (QUOTE %X)
	 (APPEND (LIST (QUOTE PROG) (QUOTE (%X %L %R %R1)))
		 (CADDR ACTION)
		 (LIST (CADDR CONTROL) (QUOTE L1) (CADR CONTROL))
		 (CADDDR CONTROL)
 		 WHILE
 		 UNLESS
		 (LIST (CAR ACTION) (QUOTE L3) (CAR CONTROL) (QUOTE (GO L1)) (QUOTE L2))
		 (CADR ACTION)))) 
EXPR)

(DEFPROP %WHILE 
 (LAMBDA(WHILE ACTION UNLESS)
  (APPEND (LIST (QUOTE PROG) (QUOTE (%R %R1)))
	  (CADDR ACTION)
	  (LIST (QUOTE L1) ((FORM (X) (COND ((NOT X) (GO L2)))) WHILE))
 	  UNLESS
	  (LIST (CAR ACTION) (QUOTE L3) (QUOTE (GO L1)) (QUOTE L2))
	  (CADR ACTION))) 
EXPR)

(DEFPROP DONEP 
 (LAMBDA(V S U)
  (COND ((NULL U) (QUOTE L9))
	(T
	 ((LAMBDA (E1) (LIST (QUOTE COND) (LIST E1 (QUOTE (GO L2)))))
	  (COND ((NUMBERP S) (LIST (COND ((MINUSP S) (QUOTE *LESS)) (T (QUOTE *GREAT))) V U))
		(T (LIST (QUOTE MINUSP) (LIST (QUOTE *TIMES) (LIST (QUOTE *DIF) U V) S)))))))) 
EXPR)